home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Module source / FEmod.txt < prev    next >
Text File  |  1993-02-23  |  7KB  |  228 lines
  1. \ Handles Mops user interface.
  2.  
  3. \ MOPS_OBJECTS sets up system objects for the Mops development environment.
  4. \ We put it first so that we can tick the exported versions of some words,
  5. \ which have to be referred to by vectors or x-arrays (since a module can
  6. \ only be invoked through an exported word).
  7.  
  8. \ Note: the various things we do below in setting up fWind can't be done
  9. \ by SysInit, since under System 7 fWind doesn't exist until a dictionary
  10. \ is read in, which is later than SysInit time.  But for an installed
  11. \ application which uses fWind, this module won't exist, so we have a
  12. \ separate initialization word AppInit (in file ObjInit) which is called
  13. \ by ObjInit for an installed application.  fWind will then be available
  14. \ from the start, so AppInit does the setting up.
  15.  
  16.  
  17. : MOPS_OBJECTS  { \ left top right bottom -- }
  18.     classinit: fWind   markalive: fWind
  19.     ['] enFW  ['] disFW        setAct: fWind
  20.     ['] (about)  -> aboutVec
  21.     myDoc title: fWind
  22.     ScreenBits  -> bottom  -> right  -> top  -> left
  23.     70 70 right bottom  true  setGrow: fWind
  24.     setContRect: fWind  ;
  25.  
  26.  
  27.     string    IMAGENAME            \ Current Mops dictionary image name
  28.     string    APPL_NAME            \ Default appl name for Install
  29.     string    APPL_VERS            \ Ditto version string
  30.     0    value    APPL_SIG        \ Ditto signature
  31.  
  32. \ SAVEBASES marks certain modules as unloaded, but saves their base addresses, without actually unloading them.  RESTOREBASES restores the base  addresses the way they were.  We do this so a dictionary save can be done, yielding a valid dictionary image with the modules marked unloaded, but without our needing to reload these modules afterwards. We also do this when the "Purge Modules" menu item is chosen.  The modules we currently treat this way are this module (vital, or we'll crash), ExtrasMod, which remembers the current source file internally, and PathsMod, which remembers the current HFS paths. If you really want to purge everything, invoke PURGE directly, which will even purge this module, probably with entertaining results.  You have been warned.
  33.  
  34. : SAVEBASES    \ ( -- sundry_info )
  35.     kludge: FEmod
  36.     kludge: extrasmod
  37.     kludge: pathsmod
  38.     kludge: windowMod
  39.     kludge: menuMod  ;
  40.  
  41. : RESTOREBASES    \ ( sundry_info -- )
  42.     unkludge: menumod
  43.     unkludge: windowmod
  44.     unkludge: pathsmod
  45.     unkludge: extrasmod
  46.     unkludge: FEmod  ;
  47.  
  48.  
  49.  
  50. \        =========== Menu handlers ===========
  51.  
  52. : (ABOUT)        50 (tstr)  cr  ;
  53.  
  54.  
  55. \        =============== File Menu ===============
  56.  
  57.     0    value    CURRVREF
  58. false    value    SAVED?        \ True if dic image saved at least once
  59.     0    value    SAVE_RC        \ I/O return code from dic save
  60.  
  61. : .SAVED
  62.     type# 101 ( Saved: )  getname: ffcb  type  cr  ;
  63.  
  64. : SAVE        \ Takes name from input stream
  65.     setname: ffcb
  66.     saveBases  (save)  -> save_rc  restoreBases  \ Note: (save) does a purge
  67.     save_rc  ?error 105  .saved  ;
  68.  
  69. : SAVEDIC
  70.     get: imageName  name: fFcb  currVref  setVref: fFcb
  71.     saveBases  (save) -> save_rc  restoreBases
  72.     save_rc  ?error 105
  73.     true -> saved?  .saved  ;
  74.  
  75. : STDSAVE        \ save via stdFile
  76.     .cur
  77.     " Save Dictionary As:"  saved? IF  get: imagename  ELSE  myDoc  THEN
  78.     stdPut: fFcb
  79.     IF
  80.         getVref: fFcb  -> currVref
  81.         getName: fFcb  put: imageName
  82.         saveDic
  83.         get: imageName  title: fWind
  84.     THEN  ;
  85.  
  86. : DOSAVE        \ Resave current dictionary.
  87.     saved?
  88.     IF    saveDic
  89.     ELSE    myDoc  put: imageName
  90.         stdSave
  91.     THEN  ;
  92.  
  93. : PRINT            \ Select and print a text file
  94.     pushnew: loadFile
  95.     'type TEXT 1 stdGet: topFile
  96.     draw: fWind
  97.     if  qPrint  then
  98.     drop: loadfile ;
  99.  
  100. \        ============= Edit Menu ===============
  101.  
  102. \ Scrap support
  103.  
  104.     string    PARMSTR
  105.     var    THEOFFSET
  106.     handle    SCRAPHDL
  107.  
  108. : GETSCRAP    \ ( -- len )
  109.     0 0 put: parmStr  handle: parmStr  put: scrapHdl
  110.     0  get: scrapHdl  'type TEXT  addr: theOffset
  111.     call GetScrap
  112.     setSize: parmStr  lock: parmStr  len: parmStr  ;
  113.  
  114. : SCRAPKEY    \ Gets next char from the scrap
  115.  
  116.     len: parmStr
  117.     NIF  key!  unlock: FEmod  13  EXIT  THEN    \ Simulate a terminal CR
  118.     1st: parmStr  1 skip: parmStr  ;
  119.  
  120. : MPASTE        \ Interprets from the scrap
  121.     lock: FEmod
  122.     getScrap 0<=  ?EXIT
  123.     false -> relocChk?  ['] scrapKey -> key  true -> relocChk?
  124.     sp0 sp!  quit  ;
  125.  
  126.  
  127. \        ============= Util Menu ===============
  128.  
  129.  
  130. \ start the object list utility via its input dialog
  131. : doOlist  3 beep ;
  132. \    " List objects of class:" doInDlg
  133. \    IF over +base over >uc objList  THEN ;
  134.  
  135. \ run the class lister
  136. : doClist  3 beep  ;
  137. \ .classes .ok ;
  138.  
  139. \ start the decompile utility via its input dialog
  140. : doDe  3 beep  ;
  141. \    " Enter word to decompile:" doDeDlg
  142. \    IF  tib 128 erase  0 -> in
  143. \        \ simulate terminal input from dialog text
  144. \        tib swap cMove de' .ok
  145. \    THEN ;
  146.  
  147. \ start the grep utility via its input dialog
  148. : doGrep 3 beep  ;
  149. \    " Enter string for search:" doGrDlg
  150. \    IF (grep) .ok THEN ;
  151.  
  152.  
  153. \        ============ Mops Menu ==============
  154.  
  155. : CHKMOPS    \ ( item# b -- ) check item if boolean is true
  156.     IF    check: mopsMen
  157.     ELSE    unCheck: mopsMen
  158.     THEN  ;
  159.  
  160. false    value    PRECHO?
  161.  
  162. : ?MOPSFLGS    1 echo? chkMops  0 prEcho? chkMops  ;
  163.  
  164. : PECHO        \ Toggles echo to printer
  165.     prEcho? not -> prEcho?
  166.     prEcho? IF  +print  ELSE  -print  drop: printmod  THEN
  167.     ?mopsFlgs  ;
  168.  
  169. : LECHO        \ Toggles echo during loads
  170.     echo? not -> echo?  ?mopsFlgs  ;
  171.  
  172. : .ROOM
  173.     cr
  174.     ." Room in dictionary:              "  room    7 .r  cr
  175.     ." Distance to top of hibase range: "  headroom    7 .r  cr
  176.     ." Total heap (no purge):           "  free    7 .r  cr
  177.     ." Largest block (purge):           "  freeblk    7 .r  cr  ;
  178.  
  179.  
  180. : DOPURGE   saveBases  purge  restoreBases  ;
  181.  
  182. : DISFW
  183.     0 disableitem: FileMen  1 disableitem: FileMen  2 disableitem: FileMen
  184.     disable: UtilMen  disable: MopsMen
  185.     false -> fWindActive?  ;
  186.  
  187. : ENFW
  188.     0 enableitem: FileMen  1  enableitem: FileMen  2 enableitem: FileMen
  189.     enable: UtilMen  enable: MopsMen
  190.     true -> fWindActive?  ;
  191.  
  192.  
  193. : NMENU
  194.     lock: menuMod
  195.     getnew: AppleMen  getnew: FileMen  getnew: EditMen
  196.     getnew: UtilMen   getnew: MopsMen
  197.     AppleMen FileMen EditMen UtilMen MopsMen  5  init: MenuBar
  198.     ?mopsFlgs  ;
  199.  
  200. \ The following words are called by Install to get and set the default name, version and signature for the current application.  They are initialized to the Mops values, but may be changed at any time.  Note that the first two of these words return a string object, rather than an addr and a length.  This was simpler for Install, and they shouldn't be getting called from anywhere else.
  201.  
  202. : GET_APPL_NAME        appl_name  ;
  203. : GET_APPL_VERS        appl_vers  ;
  204. : GET_APPL_SIG        appl_sig  ;
  205.  
  206. : SET_APPL_NAME        put: appl_name  ;
  207. : SET_APPL_VERS        put: appl_vers  ;
  208. : SET_APPL_SIG            -> appl_sig  ;
  209.  
  210. \ system startup word:
  211.  
  212. : RUN_FE
  213.     keep: FEmod
  214.     mops_objects  openMR  nMenu
  215.     " mops.paths"  getPaths
  216.     " Mops"        put: appl_name
  217.     50 getString    put: appl_vers
  218.     'type MOPS    -> appl_sig
  219.     20 -> sleepticks
  220.     select: fWind        \ Gets fWind onscreen under Stepping Out
  221.     pause pause        \ gets it to front under MultiFinder
  222.     cls  (about)  .room  ;
  223.  
  224. : (REL)
  225.     release: imageName  ;
  226.  
  227. ' (rel)  setrelease
  228.